home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / fakeer1a / shutdown.bas < prev   
BASIC Source File  |  1999-08-27  |  3KB  |  76 lines
  1. Attribute VB_Name = "Shutdown"
  2. ' Obligatory Credit to Origional Author:
  3. ' I borrowed this module (shutdown.bas) and a few linues
  4. ' in the code on the dlgError form from the following:
  5. ' Author: Shane C. Hage
  6. ' Web Download From: Http://www.planet-source-code.com/vb
  7. ' Program Source Name: "API Functions - UPDATED"
  8.  
  9. Option Explicit
  10. '-----CONSTANT DECLARATION-----
  11. Public Const EWX_LogOff As Long = 0
  12. Public Const EWX_SHUTDOWN As Long = 1
  13. Public Const EWX_REBOOT As Long = 2
  14. Public Const EWX_FORCE As Long = 4
  15. Public Const EWX_POWEROFF As Long = 8
  16. Public Const mlngWindows95 = 0
  17. Public Const mlngWindowsNT = 1
  18. '-----FUNCTION DECLARATION-----
  19. Public Declare Function ExitWindowsEx Lib "user32" (ByVal dwOptions As Long, ByVal dwReserved As Long) As Long
  20. Public Declare Function GetVersion Lib "kernel32" () As Long
  21. Private Declare Function GetLastError Lib "kernel32" () As Long
  22. Private Declare Function GetCurrentProcess Lib "kernel32" () As Long
  23. Private Declare Function OpenProcessToken Lib "advapi32" (ByVal ProcessHandle As Long, ByVal DesiredAccess As Long, TokenHandle As Long) As Long
  24. Private Declare Function LookupPrivilegeValue Lib "advapi32" Alias "LookupPrivilegeValueA" (ByVal lpSystemName As String, ByVal lpName As String, lpLuid As LUID) As Long
  25. Private Declare Function AdjustTokenPrivileges Lib "advapi32" (ByVal TokenHandle As Long, ByVal DisableAllPrivileges As Long, NewState As TOKEN_PRIVILEGES, ByVal BufferLength As Long, PreviousState As TOKEN_PRIVILEGES, ReturnLength As Long) As Long
  26. '-----TYPE DECLARATIONS-----
  27. Private Type LUID
  28.     UsedPart As Long
  29.     IgnoredForNowHigh32BitPart As Long
  30. End Type
  31. Private Type LUID_AND_ATTRIBUTES
  32.     TheLuid As LUID
  33.     Attributes As Long
  34. End Type
  35. Private Type TOKEN_PRIVILEGES
  36.     PrivilegeCount As Long
  37.     TheLuid As LUID
  38.     Attributes As Long
  39. End Type
  40. '-----MISC. DECLARATIONS-----
  41. Public glngWhichWindows32 As Long
  42. Private Declare Sub SetLastError Lib "kernel32" (ByVal dwErrCode As Long)
  43.  
  44. Public Sub AdjustToken()
  45.     Const TOKEN_ADJUST_PRIVILEGES = &H20
  46.     Const TOKEN_QUERY = &H8
  47.     Const SE_PRIVILEGE_ENABLED = &H2
  48.     Dim hdlProcessHandle As Long
  49.     Dim hdlTokenHandle As Long
  50.     Dim tmpLuid As LUID
  51.     Dim tkp As TOKEN_PRIVILEGES
  52.     Dim tkpNewButIgnored As TOKEN_PRIVILEGES
  53.     Dim lBufferNeeded As Long
  54.     SetLastError 0
  55.     hdlProcessHandle = GetCurrentProcess()
  56.     If GetLastError <> 0 Then
  57.         MsgBox "GetCurrentProcess error==" & GetLastError
  58.     End If
  59.     OpenProcessToken hdlProcessHandle, _
  60.         (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY), hdlTokenHandle
  61.     If GetLastError <> 0 Then
  62.         MsgBox "OpenProcessToken error==" & GetLastError
  63.     End If
  64.     LookupPrivilegeValue "", "SeShutdownPrivilege", tmpLuid
  65.     If GetLastError <> 0 Then
  66.         MsgBox "LookupPrivilegeValue error==" & GetLastError
  67.     End If
  68.     tkp.PrivilegeCount = 1
  69.     tkp.TheLuid = tmpLuid
  70.     tkp.Attributes = SE_PRIVILEGE_ENABLED
  71.     AdjustTokenPrivileges hdlTokenHandle, False, tkp, Len(tkpNewButIgnored), tkpNewButIgnored, lBufferNeeded
  72.     If GetLastError <> 0 Then
  73.         MsgBox "AdjustTokenPrivileges error==" & GetLastError
  74.     End If
  75. End Sub
  76.